Over 1,000 Windows 95 Programs/Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso/0800/fingerd.pas

Pascal/Delphi Source File | 1997-04-10 | 7.3 KB | 253 lines

{
  Public Domain  - Please leave this notice intact.
  Mike Caughran Cedar Island Software OCT 1994
  All the usual disclaimers apply.
  Implement a finger daemon using Borland Pascal 7

  [e-mail]
  907-789-9030 voice
  907-789-1694 bbs
}

{
  Fingerd is one of the easiest servers to implement and
  demonstrates how to use sockets clearly.
  WinCRT is used also for clarity.  (Eschew Obfuscation.)
  Finger usually resides on socket 79.

  Usage: Install a TCP/IP stack with associated WINSOCK.DLL.
         If you have no TCP/IP stack, then get TRUMPET.
         Start fingerd.exe from Windows and leave running.
         Telnet to the host running fingerd.  (use port 79
           instead of the standard telnet port 23)
         Press enter on the telnet client and you should
         see the finger information sent back to you.

         Or you can use the finger client supplied to connect
         with the finger daemon.

}


program fingerd;

uses winsock, strings, wincrt, winprocs, wintypes;

var
  myVerReqd : word;
  myWSAData : WSADATA;
  s : String[255];
  i : integer;
  CharArray: array[0..255] of char;
  HostNameArray: array[0..255] of char;
  FingerSocket, AcceptSocket : tSOCKET;
  err : integer;
  FingerPort : word;
  Remote_Addr: sockaddr_in;
  Remote_Host: Phostent;

procedure CleanUp; Forward;

{$I ERROR.INC}

{----------------------------------------}
{ -- Start of code to SubClass WinCRT -- }
{----------------------------------------}
var
  OldWndProc : TFarProc;
const
  hCRTWnd : HWND        = 0;
  cm_Exit               = 100;
  cm_About              = 101;
  USER_CONNECT         = WM_USER + 100;
  USER_READ            = WM_USER + 101;

var
  ThisLen : integer;
  ThisAddr : sockaddr;
  Buff : array [0..1024] of char;
  ReadCount,Readindex : Integer;


function WindowProc(Window:HWnd; Message,wParam:Word; lParam:LongInt) : LongInt; export;
begin
  case Message of
    wm_Char        : begin
                       if wParam=vk_Escape then begin
                         CleanUp;
                         DoneWinCRT;
                       end;
                     end;
    wm_Command     : begin
      case WParam of
    cm_About:   MessageBox(Window,
'Finger Daemon'#13'Public Domain 1994 by'#13'Mike Caughran'#13'Cedar Island Software',
                    'Pascal Finger Daemon',mb_IconQuestion);
    cm_Exit:    begin
                      CleanUp;
                      DoneWinCrt;
                    end;
      end;
    end;
    USER_CONNECT : begin
                     writeln('Received a USER_CONNECT message');
                     if (WSAGetSelectError(lparam) <> 0) then Error('USER_CONNECT msg')
                     else begin
                       ThisLen := SizeOf(Remote_Addr);
                       ThisAddr := SockAddr(Remote_Addr);
                       AcceptSocket := accept(FingerSocket, @ThisAddr, @ThisLen);

                       writeln('AcceptSocket=',acceptSocket);
                       if AcceptSocket=INVALID_SOCKET  then Error('AcceptSocket')
                       else WSAAsyncSelect(AcceptSocket, hCRTWnd, USER_READ, FD_READ);
                     end;
                   end;
    USER_READ :    begin
                      writeln('Received a USER_READ message');
                      ReadCount := recv(AcceptSocket, Buff, 1024, 0);
                      if ReadCount = SOCKET_ERROR then Error('Read')
                      else begin
                        writeln('Characters received:');
                        for ReadIndex := 0 to ReadCount do Write(Buff[ReadIndex]);
                        strCopy(Buff,'Hello from fingerd world'#0);
                        if (Send(AcceptSocket,Buff,strlen(Buff),0) < strlen(Buff))
                          then error('Send');
                      end;
                      closesocket(AcceptSocket);
                    end;
  end;
  WindowProc := CallWindowProc(OldWndProc, Window, Message, wParam, lParam);
end;

procedure MakeMenu;
var
  Menu      : HMenu;
  FileMenu  : HMenu;
begin
  Menu := CreateMenu;
  FileMenu := CreateMenu;
  AppendMenu(Menu, mf_PopUp or mf_Enabled, FileMenu, 'File');
  AppendMenu(FileMenu, mf_Enabled, cm_Exit, 'Exit');
  AppendMenu(Menu, mf_Enabled, cm_About, 'About');
  SetMenu(hCRTWnd,Menu);
end;

procedure myInitWinCRT;
var
  hInstance : THandle;
  WindowClass : TWndClass;
begin
  GetClassInfo(hInstance, 'TPWinCrt' ,WindowClass);
  UnregisterClass('TPWinCRT', hInstance);
  WindowClass.hIcon := LoadIcon(0, idi_Question);
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  OldWndProc := tFarProc(WindowClass.lpfnWndProc);
  WindowClass.lpfnWndProc := @WindowProc;
  RegisterClass(WindowClass);
  InactiveTitle := '%s';
  StrCopy(WindowTitle,'Pascal Finger Daemon V1.0');
  InitWinCrt;
  hCRTWnd := GetActiveWindow;
  MakeMenu;
end;

{--------------------------------------}
{ -- End of code to SubClass WinCRT -- }
{--------------------------------------}



procedure StartUp;
begin
  myVerReqd:=$0101;
  Writeln('Winsock version required : ',hibyte(myVerReqd),'.',lobyte(myVerReqd));
  if WSAStartup(myVerReqd,@myWSAData) <>0 then Abort('WSAStartup');
end;

procedure ShowWinSockInfo;
begin
  Write('Winsock Version found: ');
  Writeln(lobyte(myWSAData.wVersion),'.',lobyte(myWSAData.wHighVersion));
  S := StrPas(myWSAData.szDescription);
  Writeln('Description=',S);
  S := StrPas(myWSAData.szSystemStatus);
  Writeln('SystemStatus=',S);
  Writeln('MaxSockets=',word(myWSAData.iMaxSockets));
  Writeln('MaxUdpDg=',word(myWSAData.iMaxUdpDg));
  Write('VendorInfo= ');
    if myWSAData.lpVendorInfo <> NIL then begin
      writeln(myWSAData.lpVendorInfo);
    end else writeln('NULL');
  Write('Local Hostname=');
  if (gethostname(@CharArray,255) <> 0) then Error('GetHostName')
    else writeln(CharArray);
end;

procedure FindFingerService;
var
  pSE : pServEnt;
begin
  FingerPort := 0;
  pSE := getservbyname('finger','tcp');
  if pSE = nil then begin
    Error('GetServByName'); Writeln;
    Writeln('Finger is usually on port 79.  Check Services table.');
  end
  else begin
    FingerPort := htons(pSE^.s_port);
    Writeln('Using finger service on port ',FingerPort);
  end;
end;

procedure CreateSocket;
begin
  FingerSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  If FingerSocket = INVALID_SOCKET then Abort('Can''t CreateSocket')
  else
    Writeln('Socket descriptor allocated : ',ord(FingerSocket));
end;

procedure BindToSocket;
begin
  Remote_addr.sin_family := PF_INET;
  Remote_addr.sin_port := htons(FingerPort);
  Remote_addr.sin_addr.s_addr:=INADDR_ANY;
  if bind(FingerSocket, sockaddr(Remote_Addr), SizeOf(Remote_Addr)) <> 0 then
  begin
    CloseSocket(FingerSocket);
    Abort('Bind');
  end;
end;

procedure ListenToSocket;
var
  rc : integer;
begin
  rc := listen(FingerSocket,5);
  if rc > 0 then Error('Listen');
  rc := rc + WSAAsyncSelect(FingerSocket, hCRTWnd, USER_CONNECT, FD_ACCEPT);
  if rc > 0 then begin
    CloseSocket(FingerSocket);
    Abort('WSAAsyncSelect');
  end;
end;

procedure CleanUp;
begin
  if WSACleanup <> 0 then Error('WSACleanup');
end;

procedure DoFingerd;
begin
  StartUp;
  ShowWinsockInfo;
  FindFingerService;
  CreateSocket;
  BindToSocket;
  ListenToSocket;
end;

begin
  MyInitWinCRT;
  DoFingerd;
end.